Automatic Detection of Abnormal Traffic Flow Based On ANPR Data

The following page is made for anpr flow data exploration purpose. The data is taken from github repo https://github.com/ppintosilva/congestion18tynewear/blob/master/data-raw/events.R. We’ll set-up caching for this notebook given how computationally expensive some of the code we will write can get.

knitr::opts_chunk$set(cache=TRUE)
options(scipen=9999)
rm(list=ls())

Importing libraries

library(tidyverse)
library(lubridate)
#library(sf)
library(maotai)
library(ggpubr)

Define corridor level

corridor_levels = c(1, 2, 3)

Create flow dataframe for 2-3 camera pairs

flows <- read_csv(
  file = "data/corridor_A184_WEST_3cameras.csv",
  col_names = TRUE,
  col_types = list(
    o = col_integer(),
    d = col_integer(),
    t = col_datetime(),
    flow = col_integer(),
    mean_speed = col_double()
  )
) %>%
  mutate(o = factor(o, levels = corridor_levels),
         d = factor(d, levels = corridor_levels))

Get the flow data on weekday across 2-3 pair

flows_23_weekday <- 
  flows %>%
  filter(o == 2 & d == 3) %>%
  filter(wday(t, week_start = 1) < 6)

Daily flow for corridor 2-3

p_daily_flow <-
  flows_23_weekday %>%
  ggplot() +
  geom_line(
    aes(x = hms::as_hms(t), y = flow, group = as_date(t)),
    alpha = .5
  ) + 
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2, 22, 4)),
    labels = scales::label_time("%Hh")
  ) + 
  theme_bw()
p_daily_flow

Flow Descriptive Stats

flows_23_weekday %>%
  group_by(as_date(t)) %>%
  summary()
 o         d               t                            flow          mean_speed       as_date(t)        
 1:    0   1:    0   Min.   :2018-01-01 00:00:00   Min.   :  0.00   Min.   : 3.007   Min.   :2018-01-01  
 2:24961   2:    0   1st Qu.:2018-04-02 00:00:00   1st Qu.:  7.00   1st Qu.:30.195   1st Qu.:2018-04-02  
 3:    0   3:24961   Median :2018-07-02 00:00:00   Median : 48.00   Median :34.933   Median :2018-07-02  
                     Mean   :2018-07-01 00:03:03   Mean   : 63.88   Mean   :34.054   Mean   :2018-06-30  
                     3rd Qu.:2018-10-01 00:00:00   3rd Qu.: 93.00   3rd Qu.:40.890   3rd Qu.:2018-10-01  
                     Max.   :2018-12-31 00:00:00   Max.   :367.00   Max.   :65.651   Max.   :2018-12-31  
                                                                    NA's   :5333                         
p_daily_mean_speed <-
  flows_23_weekday %>%
  ggplot() +
  geom_line(
    aes(x = hms::as_hms(t), y = mean_speed, group = as_date(t)),
    alpha = .5
  ) + 
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2, 22, 4)),
    labels = scales::label_time("%Hh")
  ) + 
  theme_classic()
p_daily_mean_speed

sum(is.na(flows_23_weekday$mean_speed))
[1] 5333
sum(is.na(flows_23_weekday$flow))
[1] 0

Classify daily flow based on threshold

expected_flow <-
  flows_23_weekday %>%
  mutate(time = hms::as_hms(t)) %>%
  group_by(o,d,time) %>%
  summarise(
    median_flow = median(flow)
  )
deviation_flow <-
  flows_23_weekday %>%
  mutate(time = hms::as_hms(t)) %>%
  group_by(o, d, time) %>%
  summarise(
    mad_flow = mad(flow)
  )
flow_with_expected <- 
  flows_23_weekday %>%
  mutate(time = hms::as_hms(t)) %>%
  inner_join(expected_flow, by = c("o", "d", "time"))
flow_with_expected <- 
  flow_with_expected %>%
  mutate(har_mean_speed = mean_speed - (var(mean_speed, na.rm = TRUE)/mean_speed))
cor.test(flow_with_expected$flow, flow_with_expected$har_mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  flow_with_expected$flow and flow_with_expected$har_mean_speed
t = -89.549, df = 19626, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.5484381 -0.5285732
sample estimates:
       cor 
-0.5385805 
cor.test(flow_with_expected$flow, flow_with_expected$mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  flow_with_expected$flow and flow_with_expected$mean_speed
t = -94.53, df = 19626, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.5688786 -0.5496514
sample estimates:
       cor 
-0.5593403 
p_median <- ggplot(flow_with_expected) + 
  geom_line(aes(x = time, y = flow, group = date(t)), color = "grey") +
  geom_line(aes(x = time, y = median_flow), color = "black") +
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2, 24, 4)),
    labels = scales::label_time("%H:%M")
  ) +
  theme_bw()
p_median

flow_with_expected %>%
  filter(as_date(t) == "2018-10-02") %>%
  mutate(flow_diff = abs(flow - median_flow)) %>%
  mutate(outlier = ifelse(flow_diff > 40, TRUE, FALSE)) %>%
  ggplot() +
  geom_line(aes(x = time, y = flow_diff)) +
  geom_hline(yintercept = 40, color = "red") +
  theme_bw()

Clustering flow data using EP-MEANS

p_daily_ecdf <-
  flow_with_expected %>%
  ggplot() +
  stat_ecdf(
    aes(x = flow, group = as_date(t)),
    alpha = .7
  ) +
  xlab("Vehicle count per time period (15min)") +
  ylab("Cumulative probability") +
  theme_bw()
p_daily_ecdf

EP Means

Create flows_ecd23 (give index based on date and o-d pair)

flows_ecd23 <-
  flow_with_expected %>%
  mutate(dayt = as_date(t)) %>%
  group_by(o, d, dayt) %>%
  summarise(ecd = list(ecdf(flow))) %>%
  group_by(dayt) %>%
  mutate(date_index = group_indices()) %>%
  group_by(o, d) %>%
  mutate(group_id = group_indices())
head(flows_ecd23)
flow_with_expected %>%
  filter(as_date(t) == c("2018-04-02", "2018-01-01"))
longer object length is not a multiple of shorter object length
p_01_ecdf <-
  flow_with_expected %>%
  filter(as_date(t) == c("2018-04-02", "2018-01-02")) %>%
  ggplot() +
  stat_ecdf(
    aes(x = flow, group = as_date(t)),
    alpha = .7
  ) +
  theme_bw() +
  xlab("Vehicle count per time period (15min)") +
  ylab("Cumulative probability") 
longer object length is not a multiple of shorter object length
p_01_ecdf

Apply EP Means to flows_ecd23 with number of cluster == 2

epout_k2 <- flows_ecd23 %>%
  group_map(~ { maotai::epmeans(.x$ecd, k = 2) })
epout_k2
[[1]]
[[1]]$cluster
  [1] 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2
 [53] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 1 1 1 1 2 1 2 1 2 2 2 2 1 2 2 1 2 2 2 1 2 2
[105] 1 2 2 2 2 2 2 2 2 2 1 2 2 2 1 1 2 1 1 2 2 2 2 2 2 2 2 2 2 2 2 1 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
[157] 2 2 2 2 2 2 1 1 1 2 2 2 1 2 2 2 1 2 2 1 1 1 1 1 1 2 2 1 1 2 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[209] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1
[261] 2

[[1]]$centers
[[1]]$centers[[1]]
Empirical CDF 
Call: stats::ecdf(as.vector(tmpcpp[k, ]))
 x[1:1000] = 3.8111, 3.9107, 4.0103,  ..., 269.91,  270.9

[[1]]$centers[[2]]
Empirical CDF 
Call: stats::ecdf(as.vector(tmpcpp[k, ]))
 x[1:1000] = 1.3508, 1.3792, 1.4075,  ..., 104.71, 105.42

Create daily cluster dataframe

daily_cluster_ids <- epout_k2 %>%
  lapply(function(x) x$cluster %>%
           enframe(name = "date_index", value = "cluster")) %>%
  enframe(name = "group_id", value = "value") %>%
  unnest(value)
head(daily_cluster_ids)

Calculate 80% quantile in flow data

flow_80quantiles <- flows_23_weekday %>%
  group_by(o,d) %>%
  summarise(quantile80 = quantile(flow, 0.8))

Create centroids

Assume that the centroids which corresponds to “typical” traffic is the one who carries more traffic most of the times, i.e. will have lower cummulative probability of carrying less or equal than 80th percentile of the flow

ecd_centroids_k2 <- epout_k2 %>%
  lapply(function(x) x$centers %>% enframe(name = "cluster", value = "centroid")) %>%
  enframe(name = "group_id", value = "value") %>%
  unnest(value) %>%
  inner_join(flows_ecd23 %>% distinct(o,d) %>% mutate(group_id = group_indices()), 
             by = "group_id") %>%
  select(-group_id) %>%
  select(o, d, cluster, centroid) %>%
  # label which centroid is typical and atypical
  # for a high quantile (e.g. 80% quantile)
  inner_join(flow_80quantiles, by = c("o", "d")) %>%
  group_by(o, d, cluster) %>%
  mutate(prob80 = centroid[[1]](quantile80)) %>%
  group_by(o, d) %>%
  arrange(prob80) %>%
  mutate(cluster_label = c("typical", "atypical")) %>%
  mutate(cluster_label = factor(cluster_label)) %>%
  arrange(o, d, prob80)
max_flow <- max(flows$flow)
npoints = 500
ecd_centroids_k2_xy <- 
  ecd_centroids_k2 %>%
  group_by(o, d, cluster) %>%
  group_modify(~{
    tibble(
      cluster_label = .$cluster_label,
      ecd_x = seq(0, max_flow, length.out = npoints)
      ) %>%
        mutate(ecd_y = .x$centroid[[1]](ecd_x))
  })
od_day_labels <- flows_ecd23 %>%
  inner_join(daily_cluster_ids, by = c("group_id", "date_index")) %>%
  select(-c(date_index, group_id, ecd)) %>% 
  inner_join(
    ecd_centroids_k2 %>% distinct(o, d, cluster, cluster_label),
    by = c("o", "d", "cluster")
  )
flows_23_labelled <- 
  flows_23_weekday %>% 
  mutate(dayt = as_date(t)) %>%
  mutate(month = month(t)) %>%
  inner_join(od_day_labels %>% select (-cluster), by = c("o", "d", "dayt"))
flows_23_labelled[flows_23_labelled$month == 5,]
p_all_clustered_ecdf <-
  flows_23_labelled %>%
  mutate(tday = factor(as_date(t))) %>%
  ggplot() +
  stat_ecdf(
    aes(x = flow, group = tday, colour = cluster_label),
    alpha = .6
  ) + 
  geom_line(
    data = ecd_centroids_k2_xy,
    mapping = aes(x = ecd_x, y = ecd_y, colour = cluster_label),
    size = 2
  ) + 
  geom_vline(
    xintercept = ecd_centroids_k2$quantile80, 
    linetype = "dotted", 
    size = 1.0
    ) +
  geom_hline(
    yintercept = ecd_centroids_k2$prob80,
    linetype = "dashed",
    size = 1.0
  ) +
  scale_color_grey(name = "Daily behaviour") + 
  theme_bw() +
  xlab("Vehicle count per time period (15min)") +
  ylab("Cumulative probability")
p_all_clustered_ecdf

p_test <- 
  flows_23_labelled %>%
  mutate(tday = factor(as_date(t))) %>%
  ggplot() +
  stat_ecdf(
    aes(x = flow, group = tday, colour = cluster_label),
    alpha = .6
  ) + 
  geom_line(
    data = ecd_centroids_k2_xy,
    mapping = aes(x = ecd_x, y = ecd_y, colour = cluster_label),
    size = 2
  )
p_test

p_daily_flow_labelled <- 
  flows_23_labelled %>%
  ggplot() +
  geom_line(
    aes(x = hms::as_hms(t), y = flow, group = as_date(t)), alpha = .5
  ) + 
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2,22,4)),
    labels = scales::label_time("%Hh")
  ) + 
  facet_wrap(~cluster_label) +
  theme_bw()
p_daily_flow_labelled

p_daily_speed_labelled <- 
  flows_23_labelled %>%
  ggplot() +
  geom_line(
    aes(x = hms::as_hms(t), y = mean_speed, group = as_date(t)), alpha = .5
  ) + 
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2,22,4)),
    labels = scales::label_time("%Hh")
  ) + 
  facet_wrap(~cluster_label) +
  theme_bw()
p_daily_speed_labelled

Check correlation between labelled flow vs speed

x <- flows_23_labelled %>% filter(flow, cluster_label == "typical")
y <- flows_23_labelled %>% filter(mean_speed, cluster_label == "typical")
a <- flows_23_labelled %>% filter(flow, cluster_label == "atypical")
b <- flows_23_labelled %>% filter(mean_speed, cluster_label == "atypical")

cor.test(x$flow, y$mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  x$flow and y$mean_speed
t = -93.801, df = 12641, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.6507799 -0.6302219
sample estimates:
       cor 
-0.6406157 
cor.test(a$flow, b$mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  a$flow and b$mean_speed
t = -25.772, df = 6983, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.3159789 -0.2731468
sample estimates:
       cor 
-0.2947109 

Estimate function for each classes

flows_23_atypical <- flows_23_labelled[flows_23_labelled$cluster_label == 'atypical',]
flows_23_typical <- flows_23_labelled[flows_23_labelled$cluster_label == 'typical',]

Mean for atypical phenomenon in road segment 2-3

flows_23_atypical$time <- hms::as_hms(flows_23_atypical$t)
flows_23_atypical_mean <- aggregate(flows_23_atypical[,4], list(as.character(flows_23_atypical$time)), mean)

Mean for typical phenomenon in road segment 2-3

flows_23_typical$time <- hms::as_hms(flows_23_typical$t)
flows_23_typical_mean <- aggregate(flows_23_typical[,4], list(as.character(flows_23_typical$time)), mean)

Plot typical vs atypical

flows_23_mean_combined <- data.frame("t"=flows_23_atypical_mean$Group.1, "flow_atypical"=flows_23_atypical_mean$flow, "flow_typical"=flows_23_typical_mean$flow)
# flows_23_mean_combined$t <- as.character(flows_23_mean_combined$t)
# flows_23_mean_combined$t <- chron::as.times(flows_23_mean_combined$t)
flows_23_mean_combined$t <- as.POSIXct(flows_23_mean_combined$t, format = "%H:%M:%S")
flow_23_mean_compare <- ggplot(flows_23_mean_combined, aes(x = t)) +
  geom_line(aes(y = flow_atypical), colour = "red") +
  geom_line(aes(y = flow_typical), colour= "green") +
  scale_x_datetime(date_labels = "%H:%M") +
  theme_bw()
flow_23_mean_compare

Cluster the flows based on ep-typical median value

expected_flow_typ <- 
  flows_23_typical %>%
  mutate(time = hms::as_hms(t)) %>%
  #filter(!month(t) %in% c(3,4)) %>%
  group_by(o,d,time) %>%
  summarise(
    median_flow_typ = median(flow)
  )
deviation_flow_typ <-
  flows_23_typical %>%
  mutate(time = hms::as_hms(t)) %>%
  group_by(o, d, time) %>%
  summarise(
    mad_flow_typ = mad(flow)
  )
flow_with_expected <- inner_join(flow_with_expected, expected_flow_typ, by = c("o", "d", "time"))
expected_flow_atyp <-
  flows_23_atypical %>%
  mutate(time = hms::as_hms(t)) %>%
  #filter(!month(t) %in% c(3,4)) %>%
  group_by(o,d,time) %>%
  summarise(
    median_flow_atyp = median(flow)
  )
expected_flow_atyp_real <- 
  flows_23_atypical %>%
  filter(flow != 0) %>%
  group_by(o, d, time) %>%
  summarise(
    median_flow_atyp_real = median(flow)
  )
deviation_flow_atyp <-
  flows_23_atypical %>%
  mutate(time = hms::as_hms(t)) %>%
  group_by(o, d, time) %>%
  summarise(
    mad_flow_atyp = mad(flow)
  )
flow_with_expected <- inner_join(flow_with_expected, expected_flow_atyp, by = c("o", "d", "time"))
flow_with_expected <- inner_join(flow_with_expected, expected_flow_atyp_real, by = c("o", "d", "time"))
p_median_ep <- ggplot(flow_with_expected) + 
  geom_line(aes(x = time, y = flow, group = date(t)), color = "grey") +
  geom_line(aes(x = time, y = median_flow_typ), color = "black") +
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2, 24, 4)),
    labels = scales::label_time("%H:%M")
  ) +
  theme_bw()
p_median_ep

p_median_ep_atyp <- ggplot(flow_with_expected) + 
  geom_line(aes(x = time, y = flow, group = date(t)), color = "grey") +
  geom_line(aes(x = time, y = median_flow_atyp), color = "black") +
  scale_x_time(
    name = "Time",
    breaks = hms::hms(hours = seq(2, 24, 4)),
    labels = scales::label_time("%H:%M")
  ) +
  theme_bw()
p_median_ep

p_median_comp <- 
  ggplot(flow_with_expected) +
  geom_line(
    aes(x = time, y = flow, group = date(t)),
    color = "grey"
  ) +
  geom_line(
    aes(x = time, y = median_flow, group = date(t)),
    linetype = "solid"
  ) +
  geom_line(
    aes(x = time, y = median_flow_typ, group = date(t)),
    linetype = "dotted"
  ) +
  geom_line(
    aes(x = time, y = median_flow_atyp, group = date(t)),
    linetype = "dashed"
  ) +
  theme_bw()
p_median_comp

p_atypical_comp <- 
  ggplot(flow_with_expected) +
  geom_line(
    aes(
      x = time, 
      y = median_flow_atyp
      ),
    linetype = "solid"
  ) +
  geom_line(
    aes(
      x = time,
      y = median_flow_atyp_real
    ),
    linetype = "dashed"
  ) +
  theme(legend.position = "top") +
  xlab("Time") +
  ylab("Atypical Median") +
  theme_bw()
p_atypical_comp

ggarrange(p_median, p_median_ep, 
          ncol = 3, nrow = 1)

Variance comparison

ggplot() +
  geom_line(
    data = deviation_flow,
    aes(x = time, y = mad_flow),
    linetype = "solid"
  ) +
  geom_line(
    data = deviation_flow_typ,
    aes(x = time, y = mad_flow_typ),
    linetype = "dotted"
  ) +
  geom_line(
    data = deviation_flow_atyp,
    aes(x = time, y = mad_flow_atyp),
    linetype = "dashed"
  ) +
  theme_bw()

Flow-speed plot

flows_23_typical %>% filter(month == 6) %>%
ggplot() +
  geom_point(aes(
    x = mean_speed, 
    y = flow
  )) + 
  theme_bw()

Quadratic function fitting

quad_fit <- lm(formula = flow ~ poly(mean_speed, 2, raw = TRUE), data = flows_23_weekday)
summary(quad_fit)

Call:
lm(formula = flow ~ poly(mean_speed, 2, raw = TRUE), data = flows_23_weekday)

Residuals:
     Min       1Q   Median       3Q      Max 
-170.800  -29.449   -3.577   24.347  199.498 

Coefficients:
                                   Estimate Std. Error t value             Pr(>|t|)    
(Intercept)                      174.295536   2.855249  61.044 < 0.0000000000000002 ***
poly(mean_speed, 2, raw = TRUE)1  -0.659595   0.194332  -3.394              0.00069 ***
poly(mean_speed, 2, raw = TRUE)2  -0.056618   0.003224 -17.561 < 0.0000000000000002 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 54.85 on 19625 degrees of freedom
  (5333 observations deleted due to missingness)
Multiple R-squared:  0.3235,    Adjusted R-squared:  0.3234 
F-statistic:  4692 on 2 and 19625 DF,  p-value: < 0.00000000000000022
quad_eq <- quad_fit$coefficient[3]*flows_23_weekday$mean_speed^2 + quad_fit$coefficient[2]*flows_23_weekday$mean_speed + quad_fit$coefficient[1]
quad_eq <- as.data.frame(quad_eq)
quad_fit_plot <- flows_23_weekday %>%
  select(flow, mean_speed) %>%
  cbind(quad_eq)
quad_fit_plot
p_quad_fit <-
  ggplot(quad_fit_plot) +
  # geom_point(
  #   aes(x = mean_speed, y = flow)
  # ) +
  geom_line(
    aes(x = mean_speed, y = quad_eq)
  )
p_quad_fit

quad_fit_typical <- lm(formula = flow ~ poly(mean_speed, 2, raw = TRUE), data = flows_23_typical)
summary(quad_fit_typical)

Call:
lm(formula = flow ~ poly(mean_speed, 2, raw = TRUE), data = flows_23_typical)

Residuals:
     Min       1Q   Median       3Q      Max 
-200.863  -31.218   -1.794   31.615  169.420 

Coefficients:
                                   Estimate Std. Error t value            Pr(>|t|)    
(Intercept)                      203.955506   3.378576  60.367 <0.0000000000000002 ***
poly(mean_speed, 2, raw = TRUE)1  -0.466305   0.237505  -1.963              0.0496 *  
poly(mean_speed, 2, raw = TRUE)2  -0.076346   0.004023 -18.978 <0.0000000000000002 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 56.43 on 12640 degrees of freedom
  (605 observations deleted due to missingness)
Multiple R-squared:  0.4267,    Adjusted R-squared:  0.4266 
F-statistic:  4704 on 2 and 12640 DF,  p-value: < 0.00000000000000022
quad_fit_atypical <- lm(formula = flow ~ poly(mean_speed, 2, raw = TRUE), data = flows_23_atypical)
summary(quad_fit_atypical)

Call:
lm(formula = flow ~ poly(mean_speed, 2, raw = TRUE), data = flows_23_atypical)

Residuals:
    Min      1Q  Median      3Q     Max 
-73.385 -21.995   0.234  19.176 249.933 

Coefficients:
                                  Estimate Std. Error t value             Pr(>|t|)    
(Intercept)                      15.468279   3.743698   4.132            0.0000364 ***
poly(mean_speed, 2, raw = TRUE)1  4.851603   0.238049  20.381 < 0.0000000000000002 ***
poly(mean_speed, 2, raw = TRUE)2 -0.099861   0.003753 -26.610 < 0.0000000000000002 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 34.67 on 6982 degrees of freedom
  (4728 observations deleted due to missingness)
Multiple R-squared:  0.1709,    Adjusted R-squared:  0.1707 
F-statistic: 719.8 on 2 and 6982 DF,  p-value: < 0.00000000000000022
# Pearson Correlation test entire for entire traffics
cor.test(flows_23_weekday$flow, flows_23_weekday$mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  flows_23_weekday$flow and flows_23_weekday$mean_speed
t = -94.53, df = 19626, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.5688786 -0.5496514
sample estimates:
       cor 
-0.5593403 
# Pearson Correlation test entire for typical traffics
cor.test(flows_23_typical$flow, flows_23_typical$mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  flows_23_typical$flow and flows_23_typical$mean_speed
t = -93.801, df = 12641, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.6507799 -0.6302219
sample estimates:
       cor 
-0.6406157 
# Pearson Correlation test entire for atypical traffics
cor.test(flows_23_atypical$flow, flows_23_atypical$mean_speed, method = "pearson")

    Pearson's product-moment correlation

data:  flows_23_atypical$flow and flows_23_atypical$mean_speed
t = -25.772, df = 6983, p-value < 0.00000000000000022
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 -0.3159789 -0.2731468
sample estimates:
       cor 
-0.2947109 
flows_23_2jan <-
  flow_with_expected %>%
  filter(as_date(t) == "2018-01-02") %>%
  mutate(quantile25 = quantile(flow, 0.25)) %>%
  mutate(start = hms::as_hms(t)) %>%
  mutate(end = hms::as_hms(start + hms::as_hms("00:15:00"))) %>%
  mutate(flow_diff = abs(flow - median_flow)) %>%
  mutate(condition = ifelse(flow_diff > quantile25, "ABNORMAL", "NORMAL"))
p_clust_2jan <-
  ggplot(flows_23_2jan) +
  geom_line(
    aes(
      x = start,
      y = flow
      )
  ) +
  geom_rect(
    aes(
      xmin = start, 
      xmax = end, 
      fill = condition
      ),
    ymin = -Inf,
    ymax = Inf,
    alpha = 0.5
    ) +
  scale_fill_manual(values = c("grey", NA)) +
  xlab("Time") +
  ylab("Flow") +
  theme_bw()
p_clust_2jan

sum(flows_23_2jan$condition == "ABNORMAL")/length(flows_23_2jan$condition)
[1] 0.3645833
nrow(flows_23_weekday[flows_23_weekday$flow == 0,])/nrow(flows_23_weekday[flows_23_weekday$flow != 0,])*100
[1] 27.17037
expected_typical <- 
  flows_23_labelled %>%
  filter(cluster_label == "typical") %>%
  mutate(time = hms::as_hms(t)) %>%
  group_by(o, d, time) %>%
  summarise(
    median_typical = median(flow)
  )
flow_with_expected <- inner_join(flow_with_expected, expected_typical, by = c("o", "d", "time"))
flows_23_2jan_typ <-
  flow_with_expected %>%
  filter(as_date(t) == "2018-01-02") %>%
  mutate(quantile25 = quantile(flow, 0.25)) %>%
  mutate(start = hms::as_hms(t)) %>%
  mutate(end = hms::as_hms(start + hms::as_hms("00:15:00"))) %>%
  mutate(flow_diff = abs(flow - median_typical)) %>%
  mutate(condition = ifelse(flow_diff > quantile25, "ABNORMAL", "NORMAL"))
p_clust_2jan_typ <-
  ggplot(flows_23_2jan_typ) +
  geom_line(
    aes(
      x = start,
      y = flow
      )
  ) +
  geom_rect(
    aes(
      xmin = start, 
      xmax = end, 
      fill = condition
      ),
    ymin = -Inf,
    ymax = Inf,
    alpha = 0.5
    ) +
  scale_fill_manual(values = c("grey", NA)) +
    xlab("Time") +
  ylab("Flow") +
  theme_bw()
p_clust_2jan_typ

sum(flows_23_2jan_typ$condition == "ABNORMAL")/length(flows_23_2jan_typ$condition)
[1] 0.375
flows_23_10jul <-
  flow_with_expected %>%
  filter(as_date(t) == "2018-07-10") %>%
  mutate(quantile25 = quantile(flow, 0.25)) %>%
  mutate(start = hms::as_hms(t)) %>%
  mutate(end = hms::as_hms(start + hms::as_hms("00:15:00"))) %>%
  mutate(flow_diff = abs(flow - median_flow)) %>%
  mutate(condition = ifelse(flow_diff > quantile25, "ABNORMAL", "NORMAL"))
flows_23_10jul_typ <-
  flow_with_expected %>%
  filter(as_date(t) == "2018-07-10") %>%
  mutate(quantile25 = quantile(flow, 0.25)) %>%
  mutate(start = hms::as_hms(t)) %>%
  mutate(end = hms::as_hms(start + hms::as_hms("00:15:00"))) %>%
  mutate(flow_diff = abs(flow - median_typical)) %>%
  mutate(condition = ifelse(flow_diff > quantile25, "ABNORMAL", "NORMAL"))
p_clust_10jul <-
  ggplot(flows_23_10jul) +
  geom_line(
    aes(
      x = start,
      y = flow
      )
  ) +
  geom_rect(
    aes(
      xmin = start, 
      xmax = end, 
      fill = condition
      ),
    ymin = -Inf,
    ymax = Inf,
    alpha = 0.5
    ) +
  scale_fill_manual(values = c("grey", NA)) +
    xlab("Time") +
  ylab("Flow") +
  theme_bw()
p_clust_10jul

sum(flows_23_10jul$condition == "ABNORMAL")/length(flows_23_10jul$condition)
[1] 0.3333333
p_clust_10jul_typ <-
  ggplot(flows_23_10jul_typ) +
  geom_line(
    aes(
      x = start,
      y = flow
      )
  ) +
  geom_rect(
    aes(
      xmin = start, 
      xmax = end, 
      fill = condition
      ),
    ymin = -Inf,
    ymax = Inf,
    alpha = 0.5
    ) +
  scale_fill_manual(values = c("grey", NA)) +
    xlab("Time") +
  ylab("Flow") +
  theme_bw()
p_clust_10jul_typ

sum(flows_23_10jul_typ$condition == "ABNORMAL")/length(flows_23_10jul_typ$condition)
[1] 0.3333333
fig1 <- ggarrange(p_clust_2jan, p_clust_2jan_typ,
          labels = c("A", "B"),
          ncol = 1, nrow = 2)

annotate_figure(fig1,
                top = text_grob("Abnormal flow detection on 2 January 2018", color = "Black", face = "bold", size = 12))

fig2 <- ggarrange(p_clust_10jul, p_clust_10jul_typ,
          labels = c("A", "B"),
          ncol = 1, nrow = 2)

annotate_figure(fig2,
                top = text_grob("Abnormal flow detection on 10 July 2018", color = "Black", face = "bold", size = 12))

Atypical Flow Analysis

flows_23_atypical_real <-
  flows_23_atypical %>%
  filter(flow != 0) 
flows_23_atypical_real %>%
filter(flow == 1)
flows_23_atypical_real %>%
  filter(dayt == "2018-04-24")
LS0tCnRpdGxlOiAiUiBOb3RlYm9vayIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQoKIyBBdXRvbWF0aWMgRGV0ZWN0aW9uIG9mIEFibm9ybWFsIFRyYWZmaWMgRmxvdyBCYXNlZCBPbiBBTlBSIERhdGEKVGhlIGZvbGxvd2luZyBwYWdlIGlzIG1hZGUgZm9yIGFucHIgZmxvdyBkYXRhIGV4cGxvcmF0aW9uIHB1cnBvc2UuIFRoZSBkYXRhIGlzIHRha2VuIGZyb20gZ2l0aHViIHJlcG8gPGh0dHBzOi8vZ2l0aHViLmNvbS9wcGludG9zaWx2YS9jb25nZXN0aW9uMTh0eW5ld2Vhci9ibG9iL21hc3Rlci9kYXRhLXJhdy9ldmVudHMuUj4uIFdlJ2xsIHNldC11cCBjYWNoaW5nIGZvciB0aGlzIG5vdGVib29rIGdpdmVuIGhvdyBjb21wdXRhdGlvbmFsbHkgZXhwZW5zaXZlIHNvbWUgb2YgdGhlIGNvZGUgd2Ugd2lsbCB3cml0ZSBjYW4gZ2V0LgpgYGB7ciBzZXR1cH0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KGNhY2hlPVRSVUUpCm9wdGlvbnMoc2NpcGVuPTk5OTkpCnJtKGxpc3Q9bHMoKSkKYGBgCgojIyBJbXBvcnRpbmcgbGlicmFyaWVzCmBgYHtyIG1lc3NhZ2U9RkFMU0UsIHdhcm5pbmc9RkFMU0V9CmxpYnJhcnkodGlkeXZlcnNlKQpsaWJyYXJ5KGx1YnJpZGF0ZSkKI2xpYnJhcnkoc2YpCmxpYnJhcnkobWFvdGFpKQpsaWJyYXJ5KGdncHVicikKYGBgCgojIyBEZWZpbmUgY29ycmlkb3IgbGV2ZWwKYGBge3J9CmNvcnJpZG9yX2xldmVscyA9IGMoMSwgMiwgMykKYGBgCgojIyBDcmVhdGUgZmxvdyBkYXRhZnJhbWUgZm9yIDItMyBjYW1lcmEgcGFpcnMKYGBge3J9CmZsb3dzIDwtIHJlYWRfY3N2KAogIGZpbGUgPSAiZGF0YS9jb3JyaWRvcl9BMTg0X1dFU1RfM2NhbWVyYXMuY3N2IiwKICBjb2xfbmFtZXMgPSBUUlVFLAogIGNvbF90eXBlcyA9IGxpc3QoCiAgICBvID0gY29sX2ludGVnZXIoKSwKICAgIGQgPSBjb2xfaW50ZWdlcigpLAogICAgdCA9IGNvbF9kYXRldGltZSgpLAogICAgZmxvdyA9IGNvbF9pbnRlZ2VyKCksCiAgICBtZWFuX3NwZWVkID0gY29sX2RvdWJsZSgpCiAgKQopICU+JQogIG11dGF0ZShvID0gZmFjdG9yKG8sIGxldmVscyA9IGNvcnJpZG9yX2xldmVscyksCiAgICAgICAgIGQgPSBmYWN0b3IoZCwgbGV2ZWxzID0gY29ycmlkb3JfbGV2ZWxzKSkKYGBgCgojIyBHZXQgdGhlIGZsb3cgZGF0YSBvbiB3ZWVrZGF5IGFjcm9zcyAyLTMgcGFpcgpgYGB7cn0KZmxvd3NfMjNfd2Vla2RheSA8LSAKICBmbG93cyAlPiUKICBmaWx0ZXIobyA9PSAyICYgZCA9PSAzKSAlPiUKICBmaWx0ZXIod2RheSh0LCB3ZWVrX3N0YXJ0ID0gMSkgPCA2KQpgYGAKCiMjIERhaWx5IGZsb3cgZm9yIGNvcnJpZG9yIDItMwpgYGB7cn0KcF9kYWlseV9mbG93IDwtCiAgZmxvd3NfMjNfd2Vla2RheSAlPiUKICBnZ3Bsb3QoKSArCiAgZ2VvbV9saW5lKAogICAgYWVzKHggPSBobXM6OmFzX2htcyh0KSwgeSA9IGZsb3csIGdyb3VwID0gYXNfZGF0ZSh0KSksCiAgICBhbHBoYSA9IC41CiAgKSArIAogIHNjYWxlX3hfdGltZSgKICAgIG5hbWUgPSAiVGltZSIsCiAgICBicmVha3MgPSBobXM6Omhtcyhob3VycyA9IHNlcSgyLCAyMiwgNCkpLAogICAgbGFiZWxzID0gc2NhbGVzOjpsYWJlbF90aW1lKCIlSGgiKQogICkgKyAKICB0aGVtZV9idygpCnBfZGFpbHlfZmxvdwpgYGAKCiMjIEZsb3cgRGVzY3JpcHRpdmUgU3RhdHMKYGBge3J9CmZsb3dzXzIzX3dlZWtkYXkgJT4lCiAgZ3JvdXBfYnkoYXNfZGF0ZSh0KSkgJT4lCiAgc3VtbWFyeSgpCmBgYAoKCmBgYHtyfQpwX2RhaWx5X21lYW5fc3BlZWQgPC0KICBmbG93c18yM193ZWVrZGF5ICU+JQogIGdncGxvdCgpICsKICBnZW9tX2xpbmUoCiAgICBhZXMoeCA9IGhtczo6YXNfaG1zKHQpLCB5ID0gbWVhbl9zcGVlZCwgZ3JvdXAgPSBhc19kYXRlKHQpKSwKICAgIGFscGhhID0gLjUKICApICsgCiAgc2NhbGVfeF90aW1lKAogICAgbmFtZSA9ICJUaW1lIiwKICAgIGJyZWFrcyA9IGhtczo6aG1zKGhvdXJzID0gc2VxKDIsIDIyLCA0KSksCiAgICBsYWJlbHMgPSBzY2FsZXM6OmxhYmVsX3RpbWUoIiVIaCIpCiAgKSArIAogIHRoZW1lX2NsYXNzaWMoKQpwX2RhaWx5X21lYW5fc3BlZWQKc3VtKGlzLm5hKGZsb3dzXzIzX3dlZWtkYXkkbWVhbl9zcGVlZCkpCnN1bShpcy5uYShmbG93c18yM193ZWVrZGF5JGZsb3cpKQpgYGAKCgoKIyMjIENsYXNzaWZ5IGRhaWx5IGZsb3cgYmFzZWQgb24gdGhyZXNob2xkCmBgYHtyfQpleHBlY3RlZF9mbG93IDwtCiAgZmxvd3NfMjNfd2Vla2RheSAlPiUKICBtdXRhdGUodGltZSA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBncm91cF9ieShvLGQsdGltZSkgJT4lCiAgc3VtbWFyaXNlKAogICAgbWVkaWFuX2Zsb3cgPSBtZWRpYW4oZmxvdykKICApCmBgYAoKYGBge3J9CmRldmlhdGlvbl9mbG93IDwtCiAgZmxvd3NfMjNfd2Vla2RheSAlPiUKICBtdXRhdGUodGltZSA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBncm91cF9ieShvLCBkLCB0aW1lKSAlPiUKICBzdW1tYXJpc2UoCiAgICBtYWRfZmxvdyA9IG1hZChmbG93KQogICkKYGBgCgpgYGB7cn0KZmxvd193aXRoX2V4cGVjdGVkIDwtIAogIGZsb3dzXzIzX3dlZWtkYXkgJT4lCiAgbXV0YXRlKHRpbWUgPSBobXM6OmFzX2htcyh0KSkgJT4lCiAgaW5uZXJfam9pbihleHBlY3RlZF9mbG93LCBieSA9IGMoIm8iLCAiZCIsICJ0aW1lIikpCmBgYAoKYGBge3J9CmZsb3dfd2l0aF9leHBlY3RlZCA8LSAKICBmbG93X3dpdGhfZXhwZWN0ZWQgJT4lCiAgbXV0YXRlKGhhcl9tZWFuX3NwZWVkID0gbWVhbl9zcGVlZCAtICh2YXIobWVhbl9zcGVlZCwgbmEucm0gPSBUUlVFKS9tZWFuX3NwZWVkKSkKYGBgCgpgYGB7cn0KY29yLnRlc3QoZmxvd193aXRoX2V4cGVjdGVkJGZsb3csIGZsb3dfd2l0aF9leHBlY3RlZCRoYXJfbWVhbl9zcGVlZCwgbWV0aG9kID0gInBlYXJzb24iKQpgYGAKCmBgYHtyfQpjb3IudGVzdChmbG93X3dpdGhfZXhwZWN0ZWQkZmxvdywgZmxvd193aXRoX2V4cGVjdGVkJG1lYW5fc3BlZWQsIG1ldGhvZCA9ICJwZWFyc29uIikKYGBgCgpgYGB7cn0KcF9tZWRpYW4gPC0gZ2dwbG90KGZsb3dfd2l0aF9leHBlY3RlZCkgKyAKICBnZW9tX2xpbmUoYWVzKHggPSB0aW1lLCB5ID0gZmxvdywgZ3JvdXAgPSBkYXRlKHQpKSwgY29sb3IgPSAiZ3JleSIpICsKICBnZW9tX2xpbmUoYWVzKHggPSB0aW1lLCB5ID0gbWVkaWFuX2Zsb3cpLCBjb2xvciA9ICJibGFjayIpICsKICBzY2FsZV94X3RpbWUoCiAgICBuYW1lID0gIlRpbWUiLAogICAgYnJlYWtzID0gaG1zOjpobXMoaG91cnMgPSBzZXEoMiwgMjQsIDQpKSwKICAgIGxhYmVscyA9IHNjYWxlczo6bGFiZWxfdGltZSgiJUg6JU0iKQogICkgKwogIHRoZW1lX2J3KCkKcF9tZWRpYW4KYGBgCgpgYGB7cn0KZmxvd193aXRoX2V4cGVjdGVkICU+JQogIGZpbHRlcihhc19kYXRlKHQpID09ICIyMDE4LTEwLTAyIikgJT4lCiAgbXV0YXRlKGZsb3dfZGlmZiA9IGFicyhmbG93IC0gbWVkaWFuX2Zsb3cpKSAlPiUKICBtdXRhdGUob3V0bGllciA9IGlmZWxzZShmbG93X2RpZmYgPiA0MCwgVFJVRSwgRkFMU0UpKSAlPiUKICBnZ3Bsb3QoKSArCiAgZ2VvbV9saW5lKGFlcyh4ID0gdGltZSwgeSA9IGZsb3dfZGlmZikpICsKICBnZW9tX2hsaW5lKHlpbnRlcmNlcHQgPSA0MCwgY29sb3IgPSAicmVkIikgKwogIHRoZW1lX2J3KCkKYGBgCgojIyBDbHVzdGVyaW5nIGZsb3cgZGF0YSB1c2luZyBFUC1NRUFOUwpgYGB7cn0KcF9kYWlseV9lY2RmIDwtCiAgZmxvd193aXRoX2V4cGVjdGVkICU+JQogIGdncGxvdCgpICsKICBzdGF0X2VjZGYoCiAgICBhZXMoeCA9IGZsb3csIGdyb3VwID0gYXNfZGF0ZSh0KSksCiAgICBhbHBoYSA9IC43CiAgKSArCiAgeGxhYigiVmVoaWNsZSBjb3VudCBwZXIgdGltZSBwZXJpb2QgKDE1bWluKSIpICsKICB5bGFiKCJDdW11bGF0aXZlIHByb2JhYmlsaXR5IikgKwogIHRoZW1lX2J3KCkKcF9kYWlseV9lY2RmCmBgYAoKIyMgRVAgTWVhbnMKIyMjIENyZWF0ZSBmbG93c19lY2QyMyAoZ2l2ZSBpbmRleCBiYXNlZCBvbiBkYXRlIGFuZCBvLWQgcGFpcikgCmBgYHtyfQpmbG93c19lY2QyMyA8LQogIGZsb3dfd2l0aF9leHBlY3RlZCAlPiUKICBtdXRhdGUoZGF5dCA9IGFzX2RhdGUodCkpICU+JQogIGdyb3VwX2J5KG8sIGQsIGRheXQpICU+JQogIHN1bW1hcmlzZShlY2QgPSBsaXN0KGVjZGYoZmxvdykpKSAlPiUKICBncm91cF9ieShkYXl0KSAlPiUKICBtdXRhdGUoZGF0ZV9pbmRleCA9IGdyb3VwX2luZGljZXMoKSkgJT4lCiAgZ3JvdXBfYnkobywgZCkgJT4lCiAgbXV0YXRlKGdyb3VwX2lkID0gZ3JvdXBfaW5kaWNlcygpKQpoZWFkKGZsb3dzX2VjZDIzKQpgYGAKYGBge3J9CmZsb3dfd2l0aF9leHBlY3RlZCAlPiUKICBmaWx0ZXIoYXNfZGF0ZSh0KSA9PSBjKCIyMDE4LTA0LTAyIiwgIjIwMTgtMDEtMDEiKSkKYGBgCgpgYGB7cn0KcF8wMV9lY2RmIDwtCiAgZmxvd193aXRoX2V4cGVjdGVkICU+JQogIGZpbHRlcihhc19kYXRlKHQpID09IGMoIjIwMTgtMDQtMDIiLCAiMjAxOC0wMS0wMiIpKSAlPiUKICBnZ3Bsb3QoKSArCiAgc3RhdF9lY2RmKAogICAgYWVzKHggPSBmbG93LCBncm91cCA9IGFzX2RhdGUodCkpLAogICAgYWxwaGEgPSAuNwogICkgKwogIHRoZW1lX2J3KCkgKwogIHhsYWIoIlZlaGljbGUgY291bnQgcGVyIHRpbWUgcGVyaW9kICgxNW1pbikiKSArCiAgeWxhYigiQ3VtdWxhdGl2ZSBwcm9iYWJpbGl0eSIpIApwXzAxX2VjZGYKYGBgCgojIyMgQXBwbHkgRVAgTWVhbnMgdG8gZmxvd3NfZWNkMjMgd2l0aCBudW1iZXIgb2YgY2x1c3RlciA9PSAyCmBgYHtyfQplcG91dF9rMiA8LSBmbG93c19lY2QyMyAlPiUKICBncm91cF9tYXAofiB7IG1hb3RhaTo6ZXBtZWFucygueCRlY2QsIGsgPSAyKSB9KQplcG91dF9rMgpgYGAKCiMjIyBDcmVhdGUgZGFpbHkgY2x1c3RlciBkYXRhZnJhbWUKYGBge3J9CmRhaWx5X2NsdXN0ZXJfaWRzIDwtIGVwb3V0X2syICU+JQogIGxhcHBseShmdW5jdGlvbih4KSB4JGNsdXN0ZXIgJT4lCiAgICAgICAgICAgZW5mcmFtZShuYW1lID0gImRhdGVfaW5kZXgiLCB2YWx1ZSA9ICJjbHVzdGVyIikpICU+JQogIGVuZnJhbWUobmFtZSA9ICJncm91cF9pZCIsIHZhbHVlID0gInZhbHVlIikgJT4lCiAgdW5uZXN0KHZhbHVlKQpoZWFkKGRhaWx5X2NsdXN0ZXJfaWRzKQpgYGAKCiMjIyBDYWxjdWxhdGUgODAlIHF1YW50aWxlIGluIGZsb3cgZGF0YSAKYGBge3J9CmZsb3dfODBxdWFudGlsZXMgPC0gZmxvd3NfMjNfd2Vla2RheSAlPiUKICBncm91cF9ieShvLGQpICU+JQogIHN1bW1hcmlzZShxdWFudGlsZTgwID0gcXVhbnRpbGUoZmxvdywgMC44KSkKYGBgCgojIyMgQ3JlYXRlIGNlbnRyb2lkcwpBc3N1bWUgdGhhdCB0aGUgY2VudHJvaWRzIHdoaWNoIGNvcnJlc3BvbmRzIHRvICJ0eXBpY2FsIiB0cmFmZmljIGlzIHRoZSBvbmUgd2hvIGNhcnJpZXMgbW9yZSB0cmFmZmljIG1vc3Qgb2YgdGhlIHRpbWVzLCBpLmUuIHdpbGwgaGF2ZSBsb3dlciBjdW1tdWxhdGl2ZSBwcm9iYWJpbGl0eSBvZiBjYXJyeWluZyBsZXNzIG9yIGVxdWFsIHRoYW4gODB0aCBwZXJjZW50aWxlIG9mIHRoZSBmbG93CmBgYHtyfQplY2RfY2VudHJvaWRzX2syIDwtIGVwb3V0X2syICU+JQogIGxhcHBseShmdW5jdGlvbih4KSB4JGNlbnRlcnMgJT4lIGVuZnJhbWUobmFtZSA9ICJjbHVzdGVyIiwgdmFsdWUgPSAiY2VudHJvaWQiKSkgJT4lCiAgZW5mcmFtZShuYW1lID0gImdyb3VwX2lkIiwgdmFsdWUgPSAidmFsdWUiKSAlPiUKICB1bm5lc3QodmFsdWUpICU+JQogIGlubmVyX2pvaW4oZmxvd3NfZWNkMjMgJT4lIGRpc3RpbmN0KG8sZCkgJT4lIG11dGF0ZShncm91cF9pZCA9IGdyb3VwX2luZGljZXMoKSksIAogICAgICAgICAgICAgYnkgPSAiZ3JvdXBfaWQiKSAlPiUKICBzZWxlY3QoLWdyb3VwX2lkKSAlPiUKICBzZWxlY3QobywgZCwgY2x1c3RlciwgY2VudHJvaWQpICU+JQogICMgbGFiZWwgd2hpY2ggY2VudHJvaWQgaXMgdHlwaWNhbCBhbmQgYXR5cGljYWwKICAjIGZvciBhIGhpZ2ggcXVhbnRpbGUgKGUuZy4gODAlIHF1YW50aWxlKQogIGlubmVyX2pvaW4oZmxvd184MHF1YW50aWxlcywgYnkgPSBjKCJvIiwgImQiKSkgJT4lCiAgZ3JvdXBfYnkobywgZCwgY2x1c3RlcikgJT4lCiAgbXV0YXRlKHByb2I4MCA9IGNlbnRyb2lkW1sxXV0ocXVhbnRpbGU4MCkpICU+JQogIGdyb3VwX2J5KG8sIGQpICU+JQogIGFycmFuZ2UocHJvYjgwKSAlPiUKICBtdXRhdGUoY2x1c3Rlcl9sYWJlbCA9IGMoInR5cGljYWwiLCAiYXR5cGljYWwiKSkgJT4lCiAgbXV0YXRlKGNsdXN0ZXJfbGFiZWwgPSBmYWN0b3IoY2x1c3Rlcl9sYWJlbCkpICU+JQogIGFycmFuZ2UobywgZCwgcHJvYjgwKQpgYGAKCmBgYHtyfQptYXhfZmxvdyA8LSBtYXgoZmxvd3MkZmxvdykKbnBvaW50cyA9IDUwMApgYGAKCmBgYHtyfQplY2RfY2VudHJvaWRzX2syX3h5IDwtIAogIGVjZF9jZW50cm9pZHNfazIgJT4lCiAgZ3JvdXBfYnkobywgZCwgY2x1c3RlcikgJT4lCiAgZ3JvdXBfbW9kaWZ5KH57CiAgICB0aWJibGUoCiAgICAgIGNsdXN0ZXJfbGFiZWwgPSAuJGNsdXN0ZXJfbGFiZWwsCiAgICAgIGVjZF94ID0gc2VxKDAsIG1heF9mbG93LCBsZW5ndGgub3V0ID0gbnBvaW50cykKICAgICAgKSAlPiUKICAgICAgICBtdXRhdGUoZWNkX3kgPSAueCRjZW50cm9pZFtbMV1dKGVjZF94KSkKICB9KQpgYGAKCmBgYHtyfQpvZF9kYXlfbGFiZWxzIDwtIGZsb3dzX2VjZDIzICU+JQogIGlubmVyX2pvaW4oZGFpbHlfY2x1c3Rlcl9pZHMsIGJ5ID0gYygiZ3JvdXBfaWQiLCAiZGF0ZV9pbmRleCIpKSAlPiUKICBzZWxlY3QoLWMoZGF0ZV9pbmRleCwgZ3JvdXBfaWQsIGVjZCkpICU+JSAKICBpbm5lcl9qb2luKAogICAgZWNkX2NlbnRyb2lkc19rMiAlPiUgZGlzdGluY3QobywgZCwgY2x1c3RlciwgY2x1c3Rlcl9sYWJlbCksCiAgICBieSA9IGMoIm8iLCAiZCIsICJjbHVzdGVyIikKICApCmBgYAoKYGBge3J9CmZsb3dzXzIzX2xhYmVsbGVkIDwtIAogIGZsb3dzXzIzX3dlZWtkYXkgJT4lIAogIG11dGF0ZShkYXl0ID0gYXNfZGF0ZSh0KSkgJT4lCiAgbXV0YXRlKG1vbnRoID0gbW9udGgodCkpICU+JQogIGlubmVyX2pvaW4ob2RfZGF5X2xhYmVscyAlPiUgc2VsZWN0ICgtY2x1c3RlciksIGJ5ID0gYygibyIsICJkIiwgImRheXQiKSkKYGBgCgpgYGB7cn0KZmxvd3NfMjNfbGFiZWxsZWRbZmxvd3NfMjNfbGFiZWxsZWQkbW9udGggPT0gNSxdCmBgYAoKYGBge3J9CnBfYWxsX2NsdXN0ZXJlZF9lY2RmIDwtCiAgZmxvd3NfMjNfbGFiZWxsZWQgJT4lCiAgbXV0YXRlKHRkYXkgPSBmYWN0b3IoYXNfZGF0ZSh0KSkpICU+JQogIGdncGxvdCgpICsKICBzdGF0X2VjZGYoCiAgICBhZXMoeCA9IGZsb3csIGdyb3VwID0gdGRheSwgY29sb3VyID0gY2x1c3Rlcl9sYWJlbCksCiAgICBhbHBoYSA9IC42CiAgKSArIAogIGdlb21fbGluZSgKICAgIGRhdGEgPSBlY2RfY2VudHJvaWRzX2syX3h5LAogICAgbWFwcGluZyA9IGFlcyh4ID0gZWNkX3gsIHkgPSBlY2RfeSwgY29sb3VyID0gY2x1c3Rlcl9sYWJlbCksCiAgICBzaXplID0gMgogICkgKyAKICBnZW9tX3ZsaW5lKAogICAgeGludGVyY2VwdCA9IGVjZF9jZW50cm9pZHNfazIkcXVhbnRpbGU4MCwgCiAgICBsaW5ldHlwZSA9ICJkb3R0ZWQiLCAKICAgIHNpemUgPSAxLjAKICAgICkgKwogIGdlb21faGxpbmUoCiAgICB5aW50ZXJjZXB0ID0gZWNkX2NlbnRyb2lkc19rMiRwcm9iODAsCiAgICBsaW5ldHlwZSA9ICJkYXNoZWQiLAogICAgc2l6ZSA9IDEuMAogICkgKwogIHNjYWxlX2NvbG9yX2dyZXkobmFtZSA9ICJEYWlseSBiZWhhdmlvdXIiKSArIAogIHRoZW1lX2J3KCkgKwogIHhsYWIoIlZlaGljbGUgY291bnQgcGVyIHRpbWUgcGVyaW9kICgxNW1pbikiKSArCiAgeWxhYigiQ3VtdWxhdGl2ZSBwcm9iYWJpbGl0eSIpCnBfYWxsX2NsdXN0ZXJlZF9lY2RmCmBgYAoKYGBge3J9CnBfdGVzdCA8LSAKICBmbG93c18yM19sYWJlbGxlZCAlPiUKICBtdXRhdGUodGRheSA9IGZhY3Rvcihhc19kYXRlKHQpKSkgJT4lCiAgZ2dwbG90KCkgKwogIHN0YXRfZWNkZigKICAgIGFlcyh4ID0gZmxvdywgZ3JvdXAgPSB0ZGF5LCBjb2xvdXIgPSBjbHVzdGVyX2xhYmVsKSwKICAgIGFscGhhID0gLjYKICApICsgCiAgZ2VvbV9saW5lKAogICAgZGF0YSA9IGVjZF9jZW50cm9pZHNfazJfeHksCiAgICBtYXBwaW5nID0gYWVzKHggPSBlY2RfeCwgeSA9IGVjZF95LCBjb2xvdXIgPSBjbHVzdGVyX2xhYmVsKSwKICAgIHNpemUgPSAyCiAgKQpwX3Rlc3QKYGBgCgoKYGBge3J9CnBfZGFpbHlfZmxvd19sYWJlbGxlZCA8LSAKICBmbG93c18yM19sYWJlbGxlZCAlPiUKICBnZ3Bsb3QoKSArCiAgZ2VvbV9saW5lKAogICAgYWVzKHggPSBobXM6OmFzX2htcyh0KSwgeSA9IGZsb3csIGdyb3VwID0gYXNfZGF0ZSh0KSksIGFscGhhID0gLjUKICApICsgCiAgc2NhbGVfeF90aW1lKAogICAgbmFtZSA9ICJUaW1lIiwKICAgIGJyZWFrcyA9IGhtczo6aG1zKGhvdXJzID0gc2VxKDIsMjIsNCkpLAogICAgbGFiZWxzID0gc2NhbGVzOjpsYWJlbF90aW1lKCIlSGgiKQogICkgKyAKICBmYWNldF93cmFwKH5jbHVzdGVyX2xhYmVsKSArCiAgdGhlbWVfYncoKQpwX2RhaWx5X2Zsb3dfbGFiZWxsZWQKYGBgCgpgYGB7cn0KcF9kYWlseV9zcGVlZF9sYWJlbGxlZCA8LSAKICBmbG93c18yM19sYWJlbGxlZCAlPiUKICBnZ3Bsb3QoKSArCiAgZ2VvbV9saW5lKAogICAgYWVzKHggPSBobXM6OmFzX2htcyh0KSwgeSA9IG1lYW5fc3BlZWQsIGdyb3VwID0gYXNfZGF0ZSh0KSksIGFscGhhID0gLjUKICApICsgCiAgc2NhbGVfeF90aW1lKAogICAgbmFtZSA9ICJUaW1lIiwKICAgIGJyZWFrcyA9IGhtczo6aG1zKGhvdXJzID0gc2VxKDIsMjIsNCkpLAogICAgbGFiZWxzID0gc2NhbGVzOjpsYWJlbF90aW1lKCIlSGgiKQogICkgKyAKICBmYWNldF93cmFwKH5jbHVzdGVyX2xhYmVsKSArCiAgdGhlbWVfYncoKQpwX2RhaWx5X3NwZWVkX2xhYmVsbGVkCmBgYAoKIyMjIENoZWNrIGNvcnJlbGF0aW9uIGJldHdlZW4gbGFiZWxsZWQgZmxvdyB2cyBzcGVlZApgYGB7cn0KeCA8LSBmbG93c18yM19sYWJlbGxlZCAlPiUgZmlsdGVyKGZsb3csIGNsdXN0ZXJfbGFiZWwgPT0gInR5cGljYWwiKQp5IDwtIGZsb3dzXzIzX2xhYmVsbGVkICU+JSBmaWx0ZXIobWVhbl9zcGVlZCwgY2x1c3Rlcl9sYWJlbCA9PSAidHlwaWNhbCIpCmEgPC0gZmxvd3NfMjNfbGFiZWxsZWQgJT4lIGZpbHRlcihmbG93LCBjbHVzdGVyX2xhYmVsID09ICJhdHlwaWNhbCIpCmIgPC0gZmxvd3NfMjNfbGFiZWxsZWQgJT4lIGZpbHRlcihtZWFuX3NwZWVkLCBjbHVzdGVyX2xhYmVsID09ICJhdHlwaWNhbCIpCgpjb3IudGVzdCh4JGZsb3csIHkkbWVhbl9zcGVlZCwgbWV0aG9kID0gInBlYXJzb24iKQpjb3IudGVzdChhJGZsb3csIGIkbWVhbl9zcGVlZCwgbWV0aG9kID0gInBlYXJzb24iKQpgYGAKCiMjIEVzdGltYXRlIGZ1bmN0aW9uIGZvciBlYWNoIGNsYXNzZXMKYGBge3J9CmZsb3dzXzIzX2F0eXBpY2FsIDwtIGZsb3dzXzIzX2xhYmVsbGVkW2Zsb3dzXzIzX2xhYmVsbGVkJGNsdXN0ZXJfbGFiZWwgPT0gJ2F0eXBpY2FsJyxdCmZsb3dzXzIzX3R5cGljYWwgPC0gZmxvd3NfMjNfbGFiZWxsZWRbZmxvd3NfMjNfbGFiZWxsZWQkY2x1c3Rlcl9sYWJlbCA9PSAndHlwaWNhbCcsXQpgYGAKCiMjIyBNZWFuIGZvciBhdHlwaWNhbCBwaGVub21lbm9uIGluIHJvYWQgc2VnbWVudCAyLTMKYGBge3J9CmZsb3dzXzIzX2F0eXBpY2FsJHRpbWUgPC0gaG1zOjphc19obXMoZmxvd3NfMjNfYXR5cGljYWwkdCkKZmxvd3NfMjNfYXR5cGljYWxfbWVhbiA8LSBhZ2dyZWdhdGUoZmxvd3NfMjNfYXR5cGljYWxbLDRdLCBsaXN0KGFzLmNoYXJhY3RlcihmbG93c18yM19hdHlwaWNhbCR0aW1lKSksIG1lYW4pCmBgYAoKIyMjIE1lYW4gZm9yIHR5cGljYWwgcGhlbm9tZW5vbiBpbiByb2FkIHNlZ21lbnQgMi0zCmBgYHtyfQpmbG93c18yM190eXBpY2FsJHRpbWUgPC0gaG1zOjphc19obXMoZmxvd3NfMjNfdHlwaWNhbCR0KQpmbG93c18yM190eXBpY2FsX21lYW4gPC0gYWdncmVnYXRlKGZsb3dzXzIzX3R5cGljYWxbLDRdLCBsaXN0KGFzLmNoYXJhY3RlcihmbG93c18yM190eXBpY2FsJHRpbWUpKSwgbWVhbikKYGBgCgojIyMgUGxvdCB0eXBpY2FsIHZzIGF0eXBpY2FsCmBgYHtyfQpmbG93c18yM19tZWFuX2NvbWJpbmVkIDwtIGRhdGEuZnJhbWUoInQiPWZsb3dzXzIzX2F0eXBpY2FsX21lYW4kR3JvdXAuMSwgImZsb3dfYXR5cGljYWwiPWZsb3dzXzIzX2F0eXBpY2FsX21lYW4kZmxvdywgImZsb3dfdHlwaWNhbCI9Zmxvd3NfMjNfdHlwaWNhbF9tZWFuJGZsb3cpCiMgZmxvd3NfMjNfbWVhbl9jb21iaW5lZCR0IDwtIGFzLmNoYXJhY3RlcihmbG93c18yM19tZWFuX2NvbWJpbmVkJHQpCiMgZmxvd3NfMjNfbWVhbl9jb21iaW5lZCR0IDwtIGNocm9uOjphcy50aW1lcyhmbG93c18yM19tZWFuX2NvbWJpbmVkJHQpCmZsb3dzXzIzX21lYW5fY29tYmluZWQkdCA8LSBhcy5QT1NJWGN0KGZsb3dzXzIzX21lYW5fY29tYmluZWQkdCwgZm9ybWF0ID0gIiVIOiVNOiVTIikKYGBgCgpgYGB7cn0KZmxvd18yM19tZWFuX2NvbXBhcmUgPC0gZ2dwbG90KGZsb3dzXzIzX21lYW5fY29tYmluZWQsIGFlcyh4ID0gdCkpICsKICBnZW9tX2xpbmUoYWVzKHkgPSBmbG93X2F0eXBpY2FsKSwgY29sb3VyID0gInJlZCIpICsKICBnZW9tX2xpbmUoYWVzKHkgPSBmbG93X3R5cGljYWwpLCBjb2xvdXI9ICJncmVlbiIpICsKICBzY2FsZV94X2RhdGV0aW1lKGRhdGVfbGFiZWxzID0gIiVIOiVNIikgKwogIHRoZW1lX2J3KCkKZmxvd18yM19tZWFuX2NvbXBhcmUKYGBgCgojIyBDbHVzdGVyIHRoZSBmbG93cyBiYXNlZCBvbiBlcC10eXBpY2FsIG1lZGlhbiB2YWx1ZQpgYGB7cn0KZXhwZWN0ZWRfZmxvd190eXAgPC0gCiAgZmxvd3NfMjNfdHlwaWNhbCAlPiUKICBtdXRhdGUodGltZSA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICAjZmlsdGVyKCFtb250aCh0KSAlaW4lIGMoMyw0KSkgJT4lCiAgZ3JvdXBfYnkobyxkLHRpbWUpICU+JQogIHN1bW1hcmlzZSgKICAgIG1lZGlhbl9mbG93X3R5cCA9IG1lZGlhbihmbG93KQogICkKYGBgCgpgYGB7cn0KZGV2aWF0aW9uX2Zsb3dfdHlwIDwtCiAgZmxvd3NfMjNfdHlwaWNhbCAlPiUKICBtdXRhdGUodGltZSA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBncm91cF9ieShvLCBkLCB0aW1lKSAlPiUKICBzdW1tYXJpc2UoCiAgICBtYWRfZmxvd190eXAgPSBtYWQoZmxvdykKICApCmBgYAoKYGBge3J9CmZsb3dfd2l0aF9leHBlY3RlZCA8LSBpbm5lcl9qb2luKGZsb3dfd2l0aF9leHBlY3RlZCwgZXhwZWN0ZWRfZmxvd190eXAsIGJ5ID0gYygibyIsICJkIiwgInRpbWUiKSkKYGBgCgpgYGB7cn0KZXhwZWN0ZWRfZmxvd19hdHlwIDwtCiAgZmxvd3NfMjNfYXR5cGljYWwgJT4lCiAgbXV0YXRlKHRpbWUgPSBobXM6OmFzX2htcyh0KSkgJT4lCiAgI2ZpbHRlcighbW9udGgodCkgJWluJSBjKDMsNCkpICU+JQogIGdyb3VwX2J5KG8sZCx0aW1lKSAlPiUKICBzdW1tYXJpc2UoCiAgICBtZWRpYW5fZmxvd19hdHlwID0gbWVkaWFuKGZsb3cpCiAgKQpgYGAKCmBgYHtyfQpleHBlY3RlZF9mbG93X2F0eXBfcmVhbCA8LSAKICBmbG93c18yM19hdHlwaWNhbCAlPiUKICBmaWx0ZXIoZmxvdyAhPSAwKSAlPiUKICBncm91cF9ieShvLCBkLCB0aW1lKSAlPiUKICBzdW1tYXJpc2UoCiAgICBtZWRpYW5fZmxvd19hdHlwX3JlYWwgPSBtZWRpYW4oZmxvdykKICApCmBgYAoKCmBgYHtyfQpkZXZpYXRpb25fZmxvd19hdHlwIDwtCiAgZmxvd3NfMjNfYXR5cGljYWwgJT4lCiAgbXV0YXRlKHRpbWUgPSBobXM6OmFzX2htcyh0KSkgJT4lCiAgZ3JvdXBfYnkobywgZCwgdGltZSkgJT4lCiAgc3VtbWFyaXNlKAogICAgbWFkX2Zsb3dfYXR5cCA9IG1hZChmbG93KQogICkKYGBgCgpgYGB7cn0KZmxvd193aXRoX2V4cGVjdGVkIDwtIGlubmVyX2pvaW4oZmxvd193aXRoX2V4cGVjdGVkLCBleHBlY3RlZF9mbG93X2F0eXAsIGJ5ID0gYygibyIsICJkIiwgInRpbWUiKSkKYGBgCgpgYGB7cn0KZmxvd193aXRoX2V4cGVjdGVkIDwtIGlubmVyX2pvaW4oZmxvd193aXRoX2V4cGVjdGVkLCBleHBlY3RlZF9mbG93X2F0eXBfcmVhbCwgYnkgPSBjKCJvIiwgImQiLCAidGltZSIpKQpgYGAKCgpgYGB7cn0KcF9tZWRpYW5fZXAgPC0gZ2dwbG90KGZsb3dfd2l0aF9leHBlY3RlZCkgKyAKICBnZW9tX2xpbmUoYWVzKHggPSB0aW1lLCB5ID0gZmxvdywgZ3JvdXAgPSBkYXRlKHQpKSwgY29sb3IgPSAiZ3JleSIpICsKICBnZW9tX2xpbmUoYWVzKHggPSB0aW1lLCB5ID0gbWVkaWFuX2Zsb3dfdHlwKSwgY29sb3IgPSAiYmxhY2siKSArCiAgc2NhbGVfeF90aW1lKAogICAgbmFtZSA9ICJUaW1lIiwKICAgIGJyZWFrcyA9IGhtczo6aG1zKGhvdXJzID0gc2VxKDIsIDI0LCA0KSksCiAgICBsYWJlbHMgPSBzY2FsZXM6OmxhYmVsX3RpbWUoIiVIOiVNIikKICApICsKICB0aGVtZV9idygpCnBfbWVkaWFuX2VwCmBgYAoKYGBge3J9CnBfbWVkaWFuX2VwX2F0eXAgPC0gZ2dwbG90KGZsb3dfd2l0aF9leHBlY3RlZCkgKyAKICBnZW9tX2xpbmUoYWVzKHggPSB0aW1lLCB5ID0gZmxvdywgZ3JvdXAgPSBkYXRlKHQpKSwgY29sb3IgPSAiZ3JleSIpICsKICBnZW9tX2xpbmUoYWVzKHggPSB0aW1lLCB5ID0gbWVkaWFuX2Zsb3dfYXR5cCksIGNvbG9yID0gImJsYWNrIikgKwogIHNjYWxlX3hfdGltZSgKICAgIG5hbWUgPSAiVGltZSIsCiAgICBicmVha3MgPSBobXM6Omhtcyhob3VycyA9IHNlcSgyLCAyNCwgNCkpLAogICAgbGFiZWxzID0gc2NhbGVzOjpsYWJlbF90aW1lKCIlSDolTSIpCiAgKSArCiAgdGhlbWVfYncoKQpwX21lZGlhbl9lcApgYGAKCmBgYHtyfQpwX21lZGlhbl9jb21wIDwtIAogIGdncGxvdChmbG93X3dpdGhfZXhwZWN0ZWQpICsKICBnZW9tX2xpbmUoCiAgICBhZXMoeCA9IHRpbWUsIHkgPSBmbG93LCBncm91cCA9IGRhdGUodCkpLAogICAgY29sb3IgPSAiZ3JleSIKICApICsKICBnZW9tX2xpbmUoCiAgICBhZXMoeCA9IHRpbWUsIHkgPSBtZWRpYW5fZmxvdywgZ3JvdXAgPSBkYXRlKHQpKSwKICAgIGxpbmV0eXBlID0gInNvbGlkIgogICkgKwogIGdlb21fbGluZSgKICAgIGFlcyh4ID0gdGltZSwgeSA9IG1lZGlhbl9mbG93X3R5cCwgZ3JvdXAgPSBkYXRlKHQpKSwKICAgIGxpbmV0eXBlID0gImRvdHRlZCIKICApICsKICBnZW9tX2xpbmUoCiAgICBhZXMoeCA9IHRpbWUsIHkgPSBtZWRpYW5fZmxvd19hdHlwLCBncm91cCA9IGRhdGUodCkpLAogICAgbGluZXR5cGUgPSAiZGFzaGVkIgogICkgKwogIHRoZW1lX2J3KCkKcF9tZWRpYW5fY29tcApgYGAKCmBgYHtyfQpwX2F0eXBpY2FsX2NvbXAgPC0gCiAgZ2dwbG90KGZsb3dfd2l0aF9leHBlY3RlZCkgKwogIGdlb21fbGluZSgKICAgIGFlcygKICAgICAgeCA9IHRpbWUsIAogICAgICB5ID0gbWVkaWFuX2Zsb3dfYXR5cAogICAgICApLAogICAgbGluZXR5cGUgPSAic29saWQiCiAgKSArCiAgZ2VvbV9saW5lKAogICAgYWVzKAogICAgICB4ID0gdGltZSwKICAgICAgeSA9IG1lZGlhbl9mbG93X2F0eXBfcmVhbAogICAgKSwKICAgIGxpbmV0eXBlID0gImRhc2hlZCIKICApICsKICB0aGVtZShsZWdlbmQucG9zaXRpb24gPSAidG9wIikgKwogIHhsYWIoIlRpbWUiKSArCiAgeWxhYigiQXR5cGljYWwgTWVkaWFuIikgKwogIHRoZW1lX2J3KCkKcF9hdHlwaWNhbF9jb21wCmBgYAoKCmBgYHtyfQpnZ2FycmFuZ2UocF9tZWRpYW4sIHBfbWVkaWFuX2VwLCAKICAgICAgICAgIG5jb2wgPSAzLCBucm93ID0gMSkKYGBgCgojIyMgVmFyaWFuY2UgY29tcGFyaXNvbgpgYGB7cn0KZ2dwbG90KCkgKwogIGdlb21fbGluZSgKICAgIGRhdGEgPSBkZXZpYXRpb25fZmxvdywKICAgIGFlcyh4ID0gdGltZSwgeSA9IG1hZF9mbG93KSwKICAgIGxpbmV0eXBlID0gInNvbGlkIgogICkgKwogIGdlb21fbGluZSgKICAgIGRhdGEgPSBkZXZpYXRpb25fZmxvd190eXAsCiAgICBhZXMoeCA9IHRpbWUsIHkgPSBtYWRfZmxvd190eXApLAogICAgbGluZXR5cGUgPSAiZG90dGVkIgogICkgKwogIGdlb21fbGluZSgKICAgIGRhdGEgPSBkZXZpYXRpb25fZmxvd19hdHlwLAogICAgYWVzKHggPSB0aW1lLCB5ID0gbWFkX2Zsb3dfYXR5cCksCiAgICBsaW5ldHlwZSA9ICJkYXNoZWQiCiAgKSArCiAgdGhlbWVfYncoKQpgYGAKCgojIyBGbG93LXNwZWVkIHBsb3QKYGBge3J9CmZsb3dzXzIzX3R5cGljYWwgJT4lIGZpbHRlcihtb250aCA9PSA2KSAlPiUKZ2dwbG90KCkgKwogIGdlb21fcG9pbnQoYWVzKAogICAgeCA9IG1lYW5fc3BlZWQsIAogICAgeSA9IGZsb3cKICApKSArIAogIHRoZW1lX2J3KCkKYGBgCgojIyMgUXVhZHJhdGljIGZ1bmN0aW9uIGZpdHRpbmcKYGBge3J9CnF1YWRfZml0IDwtIGxtKGZvcm11bGEgPSBmbG93IH4gcG9seShtZWFuX3NwZWVkLCAyLCByYXcgPSBUUlVFKSwgZGF0YSA9IGZsb3dzXzIzX3dlZWtkYXkpCnN1bW1hcnkocXVhZF9maXQpCmBgYAoKYGBge3J9CnF1YWRfZXEgPC0gcXVhZF9maXQkY29lZmZpY2llbnRbM10qZmxvd3NfMjNfd2Vla2RheSRtZWFuX3NwZWVkXjIgKyBxdWFkX2ZpdCRjb2VmZmljaWVudFsyXSpmbG93c18yM193ZWVrZGF5JG1lYW5fc3BlZWQgKyBxdWFkX2ZpdCRjb2VmZmljaWVudFsxXQpxdWFkX2VxIDwtIGFzLmRhdGEuZnJhbWUocXVhZF9lcSkKYGBgCgpgYGB7cn0KcXVhZF9maXRfcGxvdCA8LSBmbG93c18yM193ZWVrZGF5ICU+JQogIHNlbGVjdChmbG93LCBtZWFuX3NwZWVkKSAlPiUKICBjYmluZChxdWFkX2VxKQpxdWFkX2ZpdF9wbG90CmBgYAoKCmBgYHtyfQpwX3F1YWRfZml0IDwtCiAgZ2dwbG90KHF1YWRfZml0X3Bsb3QpICsKICAjIGdlb21fcG9pbnQoCiAgIyAgIGFlcyh4ID0gbWVhbl9zcGVlZCwgeSA9IGZsb3cpCiAgIyApICsKICBnZW9tX2xpbmUoCiAgICBhZXMoeCA9IG1lYW5fc3BlZWQsIHkgPSBxdWFkX2VxKQogICkKcF9xdWFkX2ZpdApgYGAKCgpgYGB7cn0KcXVhZF9maXRfdHlwaWNhbCA8LSBsbShmb3JtdWxhID0gZmxvdyB+IHBvbHkobWVhbl9zcGVlZCwgMiwgcmF3ID0gVFJVRSksIGRhdGEgPSBmbG93c18yM190eXBpY2FsKQpzdW1tYXJ5KHF1YWRfZml0X3R5cGljYWwpCmBgYAoKYGBge3J9CnF1YWRfZml0X2F0eXBpY2FsIDwtIGxtKGZvcm11bGEgPSBmbG93IH4gcG9seShtZWFuX3NwZWVkLCAyLCByYXcgPSBUUlVFKSwgZGF0YSA9IGZsb3dzXzIzX2F0eXBpY2FsKQpzdW1tYXJ5KHF1YWRfZml0X2F0eXBpY2FsKQpgYGAKCmBgYHtyfQojIFBlYXJzb24gQ29ycmVsYXRpb24gdGVzdCBlbnRpcmUgZm9yIGVudGlyZSB0cmFmZmljcwpjb3IudGVzdChmbG93c18yM193ZWVrZGF5JGZsb3csIGZsb3dzXzIzX3dlZWtkYXkkbWVhbl9zcGVlZCwgbWV0aG9kID0gInBlYXJzb24iKQoKIyBQZWFyc29uIENvcnJlbGF0aW9uIHRlc3QgZW50aXJlIGZvciB0eXBpY2FsIHRyYWZmaWNzCmNvci50ZXN0KGZsb3dzXzIzX3R5cGljYWwkZmxvdywgZmxvd3NfMjNfdHlwaWNhbCRtZWFuX3NwZWVkLCBtZXRob2QgPSAicGVhcnNvbiIpCgojIFBlYXJzb24gQ29ycmVsYXRpb24gdGVzdCBlbnRpcmUgZm9yIGF0eXBpY2FsIHRyYWZmaWNzCmNvci50ZXN0KGZsb3dzXzIzX2F0eXBpY2FsJGZsb3csIGZsb3dzXzIzX2F0eXBpY2FsJG1lYW5fc3BlZWQsIG1ldGhvZCA9ICJwZWFyc29uIikKYGBgCgpgYGB7cn0KZmxvd3NfMjNfMmphbiA8LQogIGZsb3dfd2l0aF9leHBlY3RlZCAlPiUKICBmaWx0ZXIoYXNfZGF0ZSh0KSA9PSAiMjAxOC0wMS0wMiIpICU+JQogIG11dGF0ZShxdWFudGlsZTI1ID0gcXVhbnRpbGUoZmxvdywgMC4yNSkpICU+JQogIG11dGF0ZShzdGFydCA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBtdXRhdGUoZW5kID0gaG1zOjphc19obXMoc3RhcnQgKyBobXM6OmFzX2htcygiMDA6MTU6MDAiKSkpICU+JQogIG11dGF0ZShmbG93X2RpZmYgPSBhYnMoZmxvdyAtIG1lZGlhbl9mbG93KSkgJT4lCiAgbXV0YXRlKGNvbmRpdGlvbiA9IGlmZWxzZShmbG93X2RpZmYgPiBxdWFudGlsZTI1LCAiQUJOT1JNQUwiLCAiTk9STUFMIikpCmBgYAoKCmBgYHtyfQpwX2NsdXN0XzJqYW4gPC0KICBnZ3Bsb3QoZmxvd3NfMjNfMmphbikgKwogIGdlb21fbGluZSgKICAgIGFlcygKICAgICAgeCA9IHN0YXJ0LAogICAgICB5ID0gZmxvdwogICAgICApCiAgKSArCiAgZ2VvbV9yZWN0KAogICAgYWVzKAogICAgICB4bWluID0gc3RhcnQsIAogICAgICB4bWF4ID0gZW5kLCAKICAgICAgZmlsbCA9IGNvbmRpdGlvbgogICAgICApLAogICAgeW1pbiA9IC1JbmYsCiAgICB5bWF4ID0gSW5mLAogICAgYWxwaGEgPSAwLjUKICAgICkgKwogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGMoImdyZXkiLCBOQSkpICsKICB4bGFiKCJUaW1lIikgKwogIHlsYWIoIkZsb3ciKSArCiAgdGhlbWVfYncoKQpwX2NsdXN0XzJqYW4KYGBgCgpgYGB7cn0Kc3VtKGZsb3dzXzIzXzJqYW4kY29uZGl0aW9uID09ICJBQk5PUk1BTCIpL2xlbmd0aChmbG93c18yM18yamFuJGNvbmRpdGlvbikKYGBgCgoKYGBge3J9Cm5yb3coZmxvd3NfMjNfd2Vla2RheVtmbG93c18yM193ZWVrZGF5JGZsb3cgPT0gMCxdKS9ucm93KGZsb3dzXzIzX3dlZWtkYXlbZmxvd3NfMjNfd2Vla2RheSRmbG93ICE9IDAsXSkqMTAwCmBgYAoKYGBge3J9CmV4cGVjdGVkX3R5cGljYWwgPC0gCiAgZmxvd3NfMjNfbGFiZWxsZWQgJT4lCiAgZmlsdGVyKGNsdXN0ZXJfbGFiZWwgPT0gInR5cGljYWwiKSAlPiUKICBtdXRhdGUodGltZSA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBncm91cF9ieShvLCBkLCB0aW1lKSAlPiUKICBzdW1tYXJpc2UoCiAgICBtZWRpYW5fdHlwaWNhbCA9IG1lZGlhbihmbG93KQogICkKYGBgCgpgYGB7cn0KZmxvd193aXRoX2V4cGVjdGVkIDwtIGlubmVyX2pvaW4oZmxvd193aXRoX2V4cGVjdGVkLCBleHBlY3RlZF90eXBpY2FsLCBieSA9IGMoIm8iLCAiZCIsICJ0aW1lIikpCmBgYAoKYGBge3J9CmZsb3dzXzIzXzJqYW5fdHlwIDwtCiAgZmxvd193aXRoX2V4cGVjdGVkICU+JQogIGZpbHRlcihhc19kYXRlKHQpID09ICIyMDE4LTAxLTAyIikgJT4lCiAgbXV0YXRlKHF1YW50aWxlMjUgPSBxdWFudGlsZShmbG93LCAwLjI1KSkgJT4lCiAgbXV0YXRlKHN0YXJ0ID0gaG1zOjphc19obXModCkpICU+JQogIG11dGF0ZShlbmQgPSBobXM6OmFzX2htcyhzdGFydCArIGhtczo6YXNfaG1zKCIwMDoxNTowMCIpKSkgJT4lCiAgbXV0YXRlKGZsb3dfZGlmZiA9IGFicyhmbG93IC0gbWVkaWFuX3R5cGljYWwpKSAlPiUKICBtdXRhdGUoY29uZGl0aW9uID0gaWZlbHNlKGZsb3dfZGlmZiA+IHF1YW50aWxlMjUsICJBQk5PUk1BTCIsICJOT1JNQUwiKSkKYGBgCgpgYGB7cn0KcF9jbHVzdF8yamFuX3R5cCA8LQogIGdncGxvdChmbG93c18yM18yamFuX3R5cCkgKwogIGdlb21fbGluZSgKICAgIGFlcygKICAgICAgeCA9IHN0YXJ0LAogICAgICB5ID0gZmxvdwogICAgICApCiAgKSArCiAgZ2VvbV9yZWN0KAogICAgYWVzKAogICAgICB4bWluID0gc3RhcnQsIAogICAgICB4bWF4ID0gZW5kLCAKICAgICAgZmlsbCA9IGNvbmRpdGlvbgogICAgICApLAogICAgeW1pbiA9IC1JbmYsCiAgICB5bWF4ID0gSW5mLAogICAgYWxwaGEgPSAwLjUKICAgICkgKwogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGMoImdyZXkiLCBOQSkpICsKICAgIHhsYWIoIlRpbWUiKSArCiAgeWxhYigiRmxvdyIpICsKICB0aGVtZV9idygpCnBfY2x1c3RfMmphbl90eXAKYGBgCgpgYGB7cn0Kc3VtKGZsb3dzXzIzXzJqYW5fdHlwJGNvbmRpdGlvbiA9PSAiQUJOT1JNQUwiKS9sZW5ndGgoZmxvd3NfMjNfMmphbl90eXAkY29uZGl0aW9uKQpgYGAKCmBgYHtyfQpmbG93c18yM18xMGp1bCA8LQogIGZsb3dfd2l0aF9leHBlY3RlZCAlPiUKICBmaWx0ZXIoYXNfZGF0ZSh0KSA9PSAiMjAxOC0wNy0xMCIpICU+JQogIG11dGF0ZShxdWFudGlsZTI1ID0gcXVhbnRpbGUoZmxvdywgMC4yNSkpICU+JQogIG11dGF0ZShzdGFydCA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBtdXRhdGUoZW5kID0gaG1zOjphc19obXMoc3RhcnQgKyBobXM6OmFzX2htcygiMDA6MTU6MDAiKSkpICU+JQogIG11dGF0ZShmbG93X2RpZmYgPSBhYnMoZmxvdyAtIG1lZGlhbl9mbG93KSkgJT4lCiAgbXV0YXRlKGNvbmRpdGlvbiA9IGlmZWxzZShmbG93X2RpZmYgPiBxdWFudGlsZTI1LCAiQUJOT1JNQUwiLCAiTk9STUFMIikpCmBgYAoKYGBge3J9CmZsb3dzXzIzXzEwanVsX3R5cCA8LQogIGZsb3dfd2l0aF9leHBlY3RlZCAlPiUKICBmaWx0ZXIoYXNfZGF0ZSh0KSA9PSAiMjAxOC0wNy0xMCIpICU+JQogIG11dGF0ZShxdWFudGlsZTI1ID0gcXVhbnRpbGUoZmxvdywgMC4yNSkpICU+JQogIG11dGF0ZShzdGFydCA9IGhtczo6YXNfaG1zKHQpKSAlPiUKICBtdXRhdGUoZW5kID0gaG1zOjphc19obXMoc3RhcnQgKyBobXM6OmFzX2htcygiMDA6MTU6MDAiKSkpICU+JQogIG11dGF0ZShmbG93X2RpZmYgPSBhYnMoZmxvdyAtIG1lZGlhbl90eXBpY2FsKSkgJT4lCiAgbXV0YXRlKGNvbmRpdGlvbiA9IGlmZWxzZShmbG93X2RpZmYgPiBxdWFudGlsZTI1LCAiQUJOT1JNQUwiLCAiTk9STUFMIikpCmBgYAoKYGBge3J9CnBfY2x1c3RfMTBqdWwgPC0KICBnZ3Bsb3QoZmxvd3NfMjNfMTBqdWwpICsKICBnZW9tX2xpbmUoCiAgICBhZXMoCiAgICAgIHggPSBzdGFydCwKICAgICAgeSA9IGZsb3cKICAgICAgKQogICkgKwogIGdlb21fcmVjdCgKICAgIGFlcygKICAgICAgeG1pbiA9IHN0YXJ0LCAKICAgICAgeG1heCA9IGVuZCwgCiAgICAgIGZpbGwgPSBjb25kaXRpb24KICAgICAgKSwKICAgIHltaW4gPSAtSW5mLAogICAgeW1heCA9IEluZiwKICAgIGFscGhhID0gMC41CiAgICApICsKICBzY2FsZV9maWxsX21hbnVhbCh2YWx1ZXMgPSBjKCJncmV5IiwgTkEpKSArCiAgICB4bGFiKCJUaW1lIikgKwogIHlsYWIoIkZsb3ciKSArCiAgdGhlbWVfYncoKQpwX2NsdXN0XzEwanVsCmBgYAoKYGBge3J9CnN1bShmbG93c18yM18xMGp1bCRjb25kaXRpb24gPT0gIkFCTk9STUFMIikvbGVuZ3RoKGZsb3dzXzIzXzEwanVsJGNvbmRpdGlvbikKYGBgCgoKYGBge3J9CnBfY2x1c3RfMTBqdWxfdHlwIDwtCiAgZ2dwbG90KGZsb3dzXzIzXzEwanVsX3R5cCkgKwogIGdlb21fbGluZSgKICAgIGFlcygKICAgICAgeCA9IHN0YXJ0LAogICAgICB5ID0gZmxvdwogICAgICApCiAgKSArCiAgZ2VvbV9yZWN0KAogICAgYWVzKAogICAgICB4bWluID0gc3RhcnQsIAogICAgICB4bWF4ID0gZW5kLCAKICAgICAgZmlsbCA9IGNvbmRpdGlvbgogICAgICApLAogICAgeW1pbiA9IC1JbmYsCiAgICB5bWF4ID0gSW5mLAogICAgYWxwaGEgPSAwLjUKICAgICkgKwogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGMoImdyZXkiLCBOQSkpICsKICAgIHhsYWIoIlRpbWUiKSArCiAgeWxhYigiRmxvdyIpICsKICB0aGVtZV9idygpCnBfY2x1c3RfMTBqdWxfdHlwCmBgYAoKYGBge3J9CnN1bShmbG93c18yM18xMGp1bF90eXAkY29uZGl0aW9uID09ICJBQk5PUk1BTCIpL2xlbmd0aChmbG93c18yM18xMGp1bF90eXAkY29uZGl0aW9uKQpgYGAKCmBgYHtyfQpmaWcxIDwtIGdnYXJyYW5nZShwX2NsdXN0XzJqYW4sIHBfY2x1c3RfMmphbl90eXAsCiAgICAgICAgICBsYWJlbHMgPSBjKCJBIiwgIkIiKSwKICAgICAgICAgIG5jb2wgPSAxLCBucm93ID0gMikKCmFubm90YXRlX2ZpZ3VyZShmaWcxLAogICAgICAgICAgICAgICAgdG9wID0gdGV4dF9ncm9iKCJBYm5vcm1hbCBmbG93IGRldGVjdGlvbiBvbiAyIEphbnVhcnkgMjAxOCIsIGNvbG9yID0gIkJsYWNrIiwgZmFjZSA9ICJib2xkIiwgc2l6ZSA9IDEyKSkKYGBgCgpgYGB7cn0KZmlnMiA8LSBnZ2FycmFuZ2UocF9jbHVzdF8xMGp1bCwgcF9jbHVzdF8xMGp1bF90eXAsCiAgICAgICAgICBsYWJlbHMgPSBjKCJBIiwgIkIiKSwKICAgICAgICAgIG5jb2wgPSAxLCBucm93ID0gMikKCmFubm90YXRlX2ZpZ3VyZShmaWcyLAogICAgICAgICAgICAgICAgdG9wID0gdGV4dF9ncm9iKCJBYm5vcm1hbCBmbG93IGRldGVjdGlvbiBvbiAxMCBKdWx5IDIwMTgiLCBjb2xvciA9ICJCbGFjayIsIGZhY2UgPSAiYm9sZCIsIHNpemUgPSAxMikpCmBgYAoKIyMjIEF0eXBpY2FsIEZsb3cgQW5hbHlzaXMKYGBge3J9CmZsb3dzXzIzX2F0eXBpY2FsX3JlYWwgPC0KICBmbG93c18yM19hdHlwaWNhbCAlPiUKICBmaWx0ZXIoZmxvdyAhPSAwKSAKYGBgCgpgYGB7cn0KZmxvd3NfMjNfYXR5cGljYWxfcmVhbCAlPiUKZmlsdGVyKGZsb3cgPT0gMSkKYGBgCgpgYGB7cn0KZmxvd3NfMjNfYXR5cGljYWxfcmVhbCAlPiUKICBmaWx0ZXIoZGF5dCA9PSAiMjAxOC0wNC0yNCIpCmBgYAoK